home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / Billiards / components.p < prev    next >
Text File  |  1996-09-29  |  3KB  |  167 lines
  1. { components for billiard simulation }
  2. { written by Tim Budd, Oregon State University }
  3. { April 1990 }
  4.  
  5. unit billiardComponents;
  6. interface
  7.     uses
  8.         graphicUniverse;
  9.  
  10.     type
  11.  
  12.         wall = object(GraphicalObject)
  13.                 convertFactor: real;
  14.                 procedure setBounds (left, top, right, bottom: integer; cf: real);
  15.                 procedure draw; override;
  16.                 procedure hitBy (anObject: GraphicalObject); override;
  17.             end;
  18.  
  19.         hole = object(GraphicalObject)
  20.                 procedure setCenter (x, y: integer);
  21.                 procedure draw; override;
  22.                 procedure hitBy (anObject: GraphicalObject); override;
  23.             end;
  24.  
  25.         ball = object(hole)
  26.                 direction: real;
  27.                 energy: real;
  28.                 procedure draw; override;
  29.                 procedure update; override;
  30.                 procedure hitBy (anObject: GraphicalObject); override;
  31.                 function x: real;
  32.                 function y: real;
  33.             end;
  34.  
  35.     var
  36.         theUniverse: ObjectUniverse;
  37.         cueBall: ball;
  38.         saveRack: integer;
  39.  
  40.     function hitAngle (dx, dy: real): real;
  41.  
  42. implementation
  43.  
  44.     function hitAngle (dx, dy: real): real;
  45.         const
  46.             PI = 3.14159;
  47.         var
  48.             na: real;
  49.     begin
  50.         if (abs(dx) < 0.05) then
  51.             na := PI / 2
  52.         else
  53.             na := arctan(abs(dy / dx));
  54.         if (dx < 0) then
  55.             na := PI - na;
  56.         if (dy < 0) then
  57.             na := -na;
  58.         hitAngle := na;
  59.     end;
  60.  
  61.     procedure wall.setBounds (left, top, right, bottom: integer; cf: real);
  62.     begin
  63.         convertFactor := cf;
  64.         SetRect(region, left, top, right, bottom);
  65.     end;
  66.  
  67.     procedure wall.draw;
  68.     begin
  69.         PaintRect(region);
  70.     end;
  71.  
  72.     procedure wall.hitBy (anObject: GraphicalObject);
  73.         var
  74.             theBall: ball;
  75.     begin
  76.         theBall := ball(anObject);
  77.         theBall.direction := convertFactor - theBall.direction;
  78.         theUniverse.continueSimulation;
  79.         draw;
  80.     end;
  81.  
  82.     procedure hole.setCenter (x, y: integer);
  83.     begin
  84.         SetRect(region, x - 5, y - 5, x + 5, y + 5);
  85.     end;
  86.  
  87.     procedure hole.draw;
  88.     begin
  89.         PaintOval(region);
  90.     end;
  91.  
  92.     procedure hole.hitBy (anObject: GraphicalObject);
  93.         var
  94.             theBall: ball;
  95.     begin
  96.         theBall := ball(anObject);
  97.         if (theBall = cueBall) then
  98.             theBall.setCenter(50, 100)
  99.         else
  100.             begin
  101.                 saveRack := saveRack + 1;
  102.                 theBall.setCenter(10 + saveRack * 15, 250);
  103.             end;
  104.         theBall.energy := 0.0;
  105.         anObject.draw;
  106.     end;
  107.  
  108.     function ball.x: real;
  109.     begin
  110.         x := (region.left + region.right) / 2;
  111.     end;
  112.  
  113.     function ball.y: real;
  114.     begin
  115.         y := (region.top + region.bottom) / 2;
  116.     end;
  117.  
  118.  
  119.     procedure ball.draw;
  120.     begin
  121.         if (self = cueBall) then
  122.             FrameOval(region)
  123.         else
  124.             PaintOval(region);
  125.     end;
  126.  
  127.     procedure ball.update;
  128.         var
  129.             hit: GraphicalObject;
  130.             dx, dy: integer;
  131.             i, xdir, ydir, ymove: integer;
  132.     begin
  133.         if (energy > 0.5) then
  134.             begin
  135.                 erase;
  136.                 energy := energy - 0.05;
  137.                 if energy > 0.5 then
  138.                     theUniverse.continueSimulation;
  139.                 dx := trunc(5.0 * cos(direction));
  140.                 dy := trunc(5.0 * sin(direction));
  141.                 offsetRect(region, dx, dy);
  142.                 hit := theUniverse.hitObject(self);
  143.                 if hit <> nil then
  144.                     begin
  145.                         hit.hitBy(self);
  146.                         theUniverse.draw;
  147.                     end
  148.                 else
  149.                     draw;
  150.             end;
  151.     end;
  152.  
  153.     procedure ball.hitBy (anObject: GraphicalObject);
  154.         var
  155.             aBall: ball;
  156.             da: real;
  157.     begin
  158.         aBall := ball(anObject);
  159.         energy := aBall.energy / 2;
  160.         aBall.energy := energy;
  161.         direction := hitAngle(self.x - aBall.x, self.y - aBall.y);
  162.         da := aBall.direction - direction;
  163.         aBall.direction := aBall.direction + da;
  164.         theUniverse.continueSimulation;
  165.     end;
  166. end.
  167.